home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 15 / BBS in a box XV-1.iso / Files / Tele / Pete Johnson / TSet 1.6<source>.sit / HostFile.p < prev    next >
Encoding:
Text File  |  1992-04-12  |  6.5 KB  |  236 lines  |  [TEXT/PJMM]
  1. unit HostFile;
  2.  
  3. {    Created June 15, 1989.                                                }
  4.  
  5. {    Next four lines handle Debug, Names, Overflow and Range        }
  6. {    checking options in compiler.                                            }
  7.  
  8. interface
  9.  
  10.     uses
  11.         Globals, HelloTabby;
  12.  
  13.     var
  14.         CLPath, ULPath, MESSAGESPath, SysopName: STR255;
  15.         NextLaunchDateRec: DateTimeRec;
  16.         MsgPath: STR255;
  17.         LowMsg, HiMsg, MSGTXTLength: longint;
  18.         SectionCount: integer;
  19.         Sections: array[1..255] of SectionHandle;
  20.  
  21.     procedure ReadConfig;
  22.  
  23.     procedure ReadMESSAGES;
  24.  
  25.     procedure MakeTextFile (FileName: STR255);
  26.  
  27.     procedure FrameDItem (dLog: DialogPtr; iNum: integer);
  28.  
  29. implementation
  30.  
  31. {-----------------------------------------------------------------    }
  32.  
  33.     procedure FrameDItem;
  34.  
  35.         var
  36.             iBox: Rect;
  37.             iType: integer;
  38.             iHandle: Handle;
  39.             oldPenState: PenState;
  40.  
  41.     begin
  42.         GetPenState(oldPenState);
  43.         GetDItem(dLog, iNum, iType, iHandle, iBox);
  44.         InsetRect(iBox, -4, -4);
  45.         PenSize(3, 3);
  46.         FrameRoundRect(iBox, 16, 16);
  47.         SetPenState(oldPenState)
  48.     end;
  49.  
  50. {-----------------------------------------------------------------    }
  51.  
  52.     procedure MakeTextFile;
  53.  
  54. { Procedure sets up QUED-compatible text  file                                }
  55.  
  56.         var
  57.             fndrInfo: FInfo;
  58.  
  59.     begin
  60.         Err := GetFInfo(FileName, vRefNum, fndrInfo);
  61.         if Err = noErr then
  62.             begin
  63.                 fndrInfo.fdType := 'TEXT';
  64.                 fndrInfo.fdCreator := 'QED1';
  65.                 Err := SetFInfo(FileName, vRefNum, fndrInfo);
  66.             end
  67.         else
  68.             Err := Create(FileName, vRefNum, 'QED1', 'TEXT');
  69.     end;
  70.  
  71. {-----------------------------------------------------------------    }
  72.  
  73.     procedure ReadMESSAGES;
  74.  
  75. { Procedure reads the MESSAGES file                                }
  76.  
  77.         var
  78.             MSCount, MSGRefNum: integer;
  79.             MsgByte: signedByte;
  80.             MsgString: STR255;
  81.             CharsToSend: longint;
  82.             OneEntry: SectionPtr;
  83.             Counter: byte;
  84.  
  85.     begin
  86.         Err := GetVol(nil, VRefNum);        { Get volume ref # for default volume }
  87.         Counter := 0;
  88.         OneEntry := SectionPtr(NewPtr(SizeOf(Section)));
  89.         Err := FSOpen(MESSAGESPath, VRefNum, MSGRefNum);
  90.  
  91.         CharsToSend := 50;
  92.         Err := FSRead(MSGRefNum, CharsToSend, @MsgPath);
  93.         if MsgPath <> '' then
  94.             MsgPath := concat(MsgPath, ':');
  95.  
  96.         CharsToSend := 4;
  97.         Err := SetFPos(MSGRefNum, fsFromStart, 50);
  98.         Err := FSRead(MSGRefNum, CharsToSend, @LowMsg);
  99.         Err := FSRead(MSGRefNum, CharsToSend, @HiMsg);
  100.         Err := FSRead(MSGRefNum, CharsToSend, @MSGTXTLength);
  101.  
  102.         if Err = NoErr then
  103.             for MSCount := 1 to 255 do
  104.                 begin
  105.                     Err := SetFPos(MSGRefNum, fsFromStart, (62 + (MSCount - 1) * 36));
  106.                     CharsToSend := 255;
  107.                     Err := FSRead(MSGRefNum, CharsToSend, Ptr(OneEntry));
  108.                     if OneEntry^.Name <> '' then
  109.                         begin
  110.                             Counter := succ(Counter);
  111.                             Sections[Counter] := SectionHandle(NewHandle(SizeOf(Section)));
  112.                             MoveHHI(Handle(Sections[Counter]));
  113.                             HLock(Handle(Sections[Counter]));
  114.                             Sections[Counter]^^.Name := OneEntry^.Name;
  115.                             Sections[Counter]^^.Number := MSCount;
  116.                         end;
  117.                 end;
  118.         Err := FSClose(MSGRefNum);
  119.         SectionCount := Counter;
  120.         DisposPtr(Ptr(OneEntry));
  121.     end;
  122.  
  123. { ------------------------------------------------------ }
  124.  
  125.     procedure ReadConfig;
  126.  
  127. {    Reads Config file and returns Path:CallerLog, Path:UserLog, Path:MESSAGES, SysopName (all caps) and    }
  128. {    NextLaunchDateRec.                                                                                                    }
  129.  
  130.         var
  131.             AString: string;
  132.             ALongInt: LongInt;
  133.             ConfigRefNum: integer;
  134.             FileEnd, CharsToSend, NextLaunchTime: longint;
  135.             ConfigErr: OSErr;
  136.             VolName: STR255;
  137.             ConfigErrorFlag: boolean;
  138.  
  139.     begin
  140.  
  141.         ConfigErrorFlag := false;
  142.  
  143.         ConfigErr := GetVol(@VolName, VRefNum);        { Get volume ref # for default volume }
  144.         if (ConfigErr <> NoErr) then
  145.             ConfigErrorFlag := true;
  146.         MESSAGESPath := '';
  147.         ULPath := '';
  148.         CLPath := '';
  149.         SysopName := 'SYSTEM OPERATOR';
  150.         ConfigErr := FSOpen(':Config', VRefNum, ConfigRefNum);
  151.         if (ConfigErr = NoErr) then
  152.             begin
  153.                 ConfigErr := GetEOF(ConfigRefNum, FileEnd);
  154.                 if (ConfigErr = NoErr) then
  155.                     begin
  156.                         if (FileEnd > 317) then        {    Is file longer than our deepest SetFPos (it should be 349)?    }
  157.                             begin
  158.                                 CharsToSend := 41;
  159.                                 ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 57);
  160.                                 if (ConfigErr <> NoErr) then
  161.                                     ConfigErrorFlag := true;
  162.                                 ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  163.                                 if (ConfigErr <> NoErr) then
  164.                                     ConfigErrorFlag := true;
  165.                                 if length(AString) > 0 then
  166.                                     ULPath := AString;
  167.                                 ULPath := concat(ULPath, ':UserLog');
  168.  
  169.                                 if (ConfigErrorFlag = false) then
  170.                                     begin
  171.                                         CharsToSend := 41;
  172.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 98);
  173.                                         if (ConfigErr <> NoErr) then
  174.                                             ConfigErrorFlag := true;
  175.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  176.                                         if (ConfigErr <> NoErr) then
  177.                                             ConfigErrorFlag := true;
  178.                                         if length(AString) > 0 then
  179.                                             CLPath := AString;
  180.                                         CLPath := concat(CLPath, ':CallerLog');
  181.                                     end;
  182.  
  183.                                 if (ConfigErrorFlag = false) then
  184.                                     begin
  185.                                         CharsToSend := 80;
  186.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 139);
  187.                                         if (ConfigErr <> NoErr) then
  188.                                             ConfigErrorFlag := true;
  189.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  190.                                         if (ConfigErr <> NoErr) then
  191.                                             ConfigErrorFlag := true;
  192.                                         if length(AString) > 0 then
  193.                                             MESSAGESPath := AString;
  194.                                         MESSAGESPath := concat(MESSAGESPath, ':MESSAGES');
  195.                                     end;
  196.  
  197.                                 if (ConfigErrorFlag = false) then
  198.                                     begin
  199.                                         CharsToSend := 31;
  200.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 317);
  201.                                         if (ConfigErr <> NoErr) then
  202.                                             ConfigErrorFlag := true;
  203.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  204.                                         if (ConfigErr <> NoErr) then
  205.                                             ConfigErrorFlag := true;
  206.                                         if length(AString) > 0 then
  207.                                             SysopName := AString
  208.                                     end;
  209.  
  210.                                 if (ConfigErrorFlag = false) then
  211.                                     begin
  212.                                         CharsToSend := 4;
  213.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 308);
  214.                                         if (ConfigErr <> NoErr) then
  215.                                             ConfigErrorFlag := true;
  216.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @ALongInt);
  217.                                         if (ConfigErr <> NoErr) then
  218.                                             ConfigErrorFlag := true;
  219.                                         Secs2Date(ALongInt, NextLaunchDateRec);
  220.                                     end;
  221.  
  222.                             end    {    if FileEnd > 317        }
  223.                         else
  224.                             ConfigErrorFlag := true;
  225.                     end    {    Error on get eof of Config    }
  226.                 else
  227.                     ConfigErrorFlag := true;
  228.             end    {    Error on open Config    }
  229.         else
  230.             ConfigErrorFlag := true;
  231.         if ConfigErrorFlag then
  232.             ExitToShell;
  233.         ConfigErr := FSClose(ConfigRefNum);
  234.     end;
  235. { ------------------------------------------------------ }
  236. end.    {    Unit    }